home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Prog / Q-R / QB Graphics.sea / dragger.bas < prev    next >
BASIC Source File  |  1991-04-21  |  7KB  |  200 lines
  1. '------------------------------------------------------------------------------
  2. ' TITLE:    dragger
  3. ' DATE:     March 25, 1991
  4. ' AUTHOR: R. Gonzalez
  5. '
  6. ' DESCRIPTION:  Demonstrates alternative representations for an icon: sequence of
  7. '        QB primitives, "Picture" segment, or bitmap.  The icon may be "dragged" using
  8. '        the XOR drawing mode.
  9. '
  10. ' COMPILING:    Remove STATIC declarations, uncomment indicated lines
  11. '     Check: Include MBPCs & MBLCs, Include runtime code, Make all arrays static,
  12. '     Use default window & menu, (if available: Generate 68020 & 68881 code).
  13. '
  14. ' (MODIFICATION HISTORY)
  15. ' DATE:
  16. ' AUTHOR:
  17. ' DESCRIPTION:
  18. '------------------------------------------------------------------------------
  19.  
  20. DEF FNdistance%(x1%,y1%,x2%,y2%) = SQR((x1%-x2%)*(x1%-x2%)+(y1%-y2%)*(y1%-y2%))
  21. DIM SHARED points%,radius%,TRUE%,FALSE%,ast$,ast%(1000),pi
  22.  
  23. 'MAIN
  24.  
  25.     DIM method$,menu.item%,mouse.event%,a.x%,a.y%,rect%(4)
  26.  
  27.     TRUE% = -1
  28.     FALSE% = 0
  29.     pi = 3.14159
  30.     radius% = 20        'ast%() is only big enough for about radius=60 (?)
  31.     points% = 10
  32.     initialize method$
  33.     
  34.     CLS
  35.     a.x% = 100
  36.     a.y% = 100
  37.     PENMODE 10    'this helps overlapped areas of initial asterix be erased correctly
  38.     asterix a.x%,a.y%
  39.     PENMODE 8    'reset mode to COPY
  40.     setrect rect%(0),100,150,200,200
  41.     textbox "Presently using the "+method$+" method",rect%(0),0
  42.     
  43.     'event loop (File and Edit menus handled automatically by QB)
  44.     WHILE TRUE%
  45.         IF MENU(0) = 3 THEN
  46.             menu.item% = MENU(1)
  47.             handle.method.menu menu.item%,method$
  48.             forecolor 30
  49.             asterix a.x%,a.y%    'erase asterix in case text overlaps it
  50.             forecolor 33
  51.             textbox "Presently using the "+method$+" method",rect%(0),0
  52.             PENMODE 10 
  53.             asterix a.x%,a.y%    'restore asterix in case text overlaps it
  54.             PENMODE 8  
  55.         END IF
  56.         IF MOUSE(0) = -1 THEN
  57.             handle.mouse.down method$,a.x%,a.y%
  58.         END IF
  59.     WEND
  60.  
  61. END
  62.  
  63. '------------------------------------------------------------------------------
  64. ' initialize menu and icon representations
  65. ' Note when the "showlevel" is 0 or less, the pen is hidden.  HIDEPEN decrements
  66. ' the "showlevel" and SHOWPEN increments it.
  67. '------------------------------------------------------------------------------
  68. SUB initialize (method$) STATIC
  69.  
  70.     method$ = "Primitives"
  71.     draw.menu method$
  72.  
  73.     SHOWPEN    'pen must be on so GET will work.  This makes "showlevel"=2
  74.     PICTURE ON    'note this issues a HIDEPEN, which reduces "showlevel" to 1
  75.     PENMODE 10        'change pen mode to XOR for Segment method
  76.     asterix radius%,radius%
  77.     PENMODE 8
  78.     PICTURE OFF    'this issues a SHOWPEN, increasing "showlevel" to 2
  79.     HIDEPEN        'reduce "showlevel" to 1 again.
  80.     
  81.     ast$ = PICTURE$
  82.  
  83.     GET (0,0)-(radius%*2,radius%*2),ast%
  84.     PUT (0,0),ast%        'redraw initial asterix - note XOR is default so it is erased
  85.     
  86.  
  87. END SUB
  88.     
  89. '------------------------------------------------------------------------------
  90. ' draw menu bar; checkmark by specified method
  91. '------------------------------------------------------------------------------
  92. SUB draw.menu (method$) STATIC
  93.  
  94.     'use default File and Edit menus
  95.  
  96.     MENU 3,0,1,"Draw method"
  97.     MENU 3,1,1,"Primitives"
  98.     MENU 3,2,1,"Segment"
  99.     MENU 3,3,1,"Bitmap"
  100.  
  101.     IF method$ = "Primitives" THEN
  102.         MENU 3,1,2
  103.     ELSEIF method$ = "Segment" THEN
  104.         MENU 3,2,2
  105.     ELSE
  106.         MENU 3,3,2
  107.     END IF
  108.     
  109. END SUB
  110.  
  111. '------------------------------------------------------------------------------
  112. ' draw an asterix at the location specified
  113. ' Note we are using Toolbox equivalents of CIRCLE and LINE, so they will
  114. ' work correctly with PENMODE statements.
  115. '------------------------------------------------------------------------------
  116. SUB asterix (x%,y%) STATIC
  117.     'for compiler only:
  118. '    dim angle,rect%(4)
  119.  
  120.     ' Important! VARPTR gets the pointer (machine address) to a variable, for use by
  121.     ' certain Toolbox routines.  If you misuse it you are likely to crash the computer!
  122.     setrect rect%(0),x%-radius%,y%-radius%,x%+radius%,y%+radius%
  123.     FRAMEOVAL VARPTR(rect%(0))
  124.  
  125.     FOR angle = .01 TO 2*pi STEP pi/points%
  126.         MOVETO x%,y%
  127.         LINETO x%+radius%*COS(angle),y%+radius%*SIN(angle)
  128.     NEXT
  129.     
  130. END SUB
  131.  
  132. '------------------------------------------------------------------------------
  133. ' handle selection from method menu
  134. '------------------------------------------------------------------------------
  135. SUB handle.method.menu (item.no%,method$) STATIC
  136.  
  137.     SELECT CASE item.no%
  138.         CASE 1:    method$ = "Primitives"
  139.         
  140.         CASE 2:    method$ = "Segment"
  141.         
  142.         CASE 3:    method$ = "Bitmap"
  143.         
  144.         CASE ELSE:
  145.         
  146.     END SELECT
  147.     
  148.     draw.menu method$
  149.  
  150. END SUB
  151.  
  152. '------------------------------------------------------------------------------
  153. ' handle mouse event
  154. '------------------------------------------------------------------------------
  155. SUB handle.mouse.down (method$,a.x%,a.y%) STATIC
  156.  
  157.     'for compiler only:
  158. '    dim m.x%,m.y%,m.x.old%,m.y.old%
  159.  
  160.     m.x% = MOUSE(3)        'where mouse button was first pressed - x
  161.     m.y% = MOUSE(4)        'where mouse button was first pressed - y
  162.  
  163.     IF FNdistance%(a.x%,a.y%,m.x%,m.y%) < radius% THEN        'in asterix
  164.         PENMODE 10        'change pen mode to XOR for "Primitives" method
  165.         m.x.old% = m.x%
  166.         m.y.old% = m.y%
  167.         
  168.         'local event loop, since other events can't occur while "dragging" icon
  169.         WHILE MOUSE(0) = -1        'while mouse still down
  170.             m.x% = MOUSE(1)
  171.             m.y% = MOUSE(2)
  172.             IF FNdistance%(m.x%,m.y%,m.x.old%,m.y.old%) > 0 THEN
  173.                 SELECT CASE method$
  174.                     CASE "Primitives":    asterix a.x%,a.y%
  175.                                                       a.x% = a.x%+m.x%-m.x.old%
  176.                                                       a.y% = a.y%+m.y%-m.y.old%
  177.                                                       asterix a.x%,a.y%
  178.                                                       
  179.                     CASE "Segment":       PICTURE (a.x%-radius%,a.y%-radius%),ast$
  180.                                                       a.x% = a.x%+m.x%-m.x.old%
  181.                                                       a.y% = a.y%+m.y%-m.y.old%
  182.                                                       PICTURE (a.x%-radius%,a.y%-radius%),ast$
  183.  
  184.                     CASE "Bitmap":         PUT (a.x%-radius%,a.y%-radius%),ast%
  185.                                                       a.x% = a.x%+m.x%-m.x.old%
  186.                                                       a.y% = a.y%+m.y%-m.y.old%
  187.                                                       PUT (a.x%-radius%,a.y%-radius%),ast%
  188.  
  189.                 END SELECT
  190.                 m.x.old% = m.x%
  191.                 m.y.old% = m.y%
  192.             END IF
  193.         WEND
  194.         
  195.         PENMODE 8    'reset penmode to COPY
  196.     END IF
  197.  
  198. END SUB
  199.  
  200.